home *** CD-ROM | disk | FTP | other *** search
/ Creative Computers / Creative Computers CD-ROM, Volume 1 (Legendary Design Technologies, Inc.)(1994).iso / shareware / intuition / reqtools_2.1e / glue / m2amiga / m2amiga_glue.lha / ReqToolsDemo.mod < prev    next >
Text File  |  1992-08-11  |  17KB  |  431 lines
  1. (* ------------------------------------------------------------------------
  2.   :Program.       ReqToolsDemo
  3.   :Contents.      Demonstrates use auf Nico François' reqtools.library
  4.   :Author.        Kai Bolay [kai] (C-Version by Nico François)
  5.   :Address.       Hoffmannstraße 168
  6.   :Address.       D-7250 Leonberg 1 (Germany)
  7.   :Address.       UUCP: ...!cbmvax!cbmehq!cbmger!depot1!amokle!kai
  8.   :Address.       FIDO: 2:247/706.3
  9.   :History.       v1.0 [kai] 22-Nov-91 (translated from C)
  10.   :History.       v1.0m [Frank Lömker] 24-Feb-92 Umsetzung nach Modula
  11.   :History.       v2.0m [Frank Lömker] 10-Aug-92 ReqTools V38
  12.   :Copyright.     Public Domain
  13.   :Language.      Modula
  14.   :Translator.    M2Amiga V4.0d
  15.   :Imports.       ReqTools, ReqToolsSupport
  16.   :Remark.        Thanks to Nico for his great library
  17.   :Bugs.          ReqTools/Arq should support each other
  18.   :Bugs.          Font-Hook: ta.name can contain odd pointer :-(
  19. ------------------------------------------------------------------------ *)
  20.  
  21. (*********************************
  22. *                                *
  23. *  reqtools.library (V38)        *
  24. *                                *
  25. *  Release 2.0                   *
  26. *                                *
  27. *  (c) 1991/1992 Nico François   *
  28. *                                *
  29. *  demo.c                        *
  30. *                                *
  31. *  This source is public domain  *
  32. *  in all respects.              *
  33. *                                *
  34. *********************************)
  35.  
  36. MODULE ReqToolsDemo;
  37. (*$ DEFINE DoHook:=FALSE *)
  38.  
  39. FROM GraphicsD IMPORT TextAttrPtr;
  40. FROM DosL IMPORT Output,Write;
  41. FROM DosD IMPORT FileInfoBlockPtr;
  42. FROM IntuitionD IMPORT IDCMPFlags,IDCMPFlagSet;
  43. FROM SYSTEM IMPORT ADDRESS,ADR,SETREG,REG,TAG,CAST,LONGSET;
  44. FROM Arts IMPORT kickVersion;
  45. FROM UtilityD IMPORT Hook,HookPtr,tagEnd;
  46. FROM String IMPORT Length;
  47. IMPORT rt: ReqTools;
  48. FROM ReqToolsSupport IMPORT EZRequest,vEZRequest,EZRequestTags,vEZRequestTags;
  49.  
  50. VAR tagbuf:ARRAY [0..11] OF LONGINT;
  51.     filereq: rt.FileRequesterPtr;
  52.     fontreq: rt.FontRequesterPtr;
  53.     scrmodereq: rt.ScreenModeRequesterPtr;
  54.     myhook: Hook;
  55.     buffer: ARRAY [0..127] OF CHAR;
  56.     filename: ARRAY [0..33] OF CHAR;
  57.     longnum, ret, color: LONGINT;
  58.     adr, adr2: ADDRESS;
  59.  
  60. PROCEDURE myputs (str: ARRAY OF CHAR);
  61. BEGIN
  62.   IF Output() # NIL THEN
  63.     (*$ StackParms:=TRUE *)
  64.     SETREG (0,Write (Output(), ADR(str), Length (str) ));
  65.     (*$ POP StackParms *)
  66.   END;
  67. END myputs;
  68.  
  69. (*$ IF DoHook *)
  70.  
  71. (*$ StackChk:=FALSE SaveA4:=TRUE *)
  72. PROCEDURE FileFilterfunc (hook{8}: HookPtr;
  73.                       filereq{10}: ADDRESS;
  74.                       fib{9}: ADDRESS):ADDRESS;
  75. BEGIN
  76.   SETREG (12,hook^.data);
  77.   myputs (CAST(FileInfoBlockPtr,fib)^.fileName); myputs ("\n");
  78.   RETURN ADDRESS(TRUE);
  79. END FileFilterfunc;
  80. (*$ POP StackChk *)
  81.  
  82. (*$ StackChk:=FALSE SaveA4:=TRUE *)
  83. PROCEDURE FontFilterfunc (hook{8}: HookPtr;
  84.                           fontreq{10}: ADDRESS;
  85.                           textattr{9}: ADDRESS):ADDRESS;
  86. VAR n:POINTER TO ARRAY [0..127] OF CHAR;
  87. BEGIN
  88.   SETREG (12,hook^.data);
  89.   n:=CAST(TextAttrPtr,textattr)^.name;
  90.   myputs (n^); (* May contain odd Pointer :-( *)
  91.   myputs ("\n");   (* ^ Bei mir (Frank) hat es funktioniert *)
  92.   RETURN  ADDRESS(TRUE);
  93. END FontFilterfunc;
  94. (*$ POP StackChk *)
  95.  
  96. (*$ StackChk:=FALSE SaveA4:=TRUE *)
  97. PROCEDURE VolFilterfunc (hook{8}: HookPtr;
  98.                          filereq{10}: ADDRESS;
  99.                          volentry{9}: ADDRESS):ADDRESS;
  100. VAR n:POINTER TO ARRAY [0..127] OF CHAR;
  101. BEGIN
  102.   SETREG (12,hook^.data);
  103.   IF CAST(rt.VolumeEntryPtr,volentry)^.type=0 THEN myputs ("(Volume) ");
  104.                                               ELSE myputs ("(Assign) "); END;
  105.   n:=CAST(rt.VolumeEntryPtr,volentry)^.name;
  106.   myputs (n^); myputs ("\n");
  107.   RETURN ADDRESS(TRUE);
  108. END VolFilterfunc;
  109. (*$ POP StackChk *)
  110.  
  111. (*$ ENDIF *)
  112.  
  113. BEGIN
  114.   vEZRequest (ADR("ReqTools 2.0 Demo\n"+
  115.               "~~~~~~~~~~~~~~~~~\n"+
  116.               "'reqtools.library' offers several\ndifferent types of requesters:"),
  117.               ADR("Let's see them"), NIL, NIL, NIL);
  118.  
  119.   vEZRequest (ADR("NUMBER 1:\nThe larch :-)"),ADR("Be serious!"), NIL, NIL,NIL);
  120.  
  121.   vEZRequest (ADR("NUMBER 1:\nString requester\nfunction: rt.GetString()"),
  122.               ADR("Show me"),NIL, NIL, NIL);
  123.  
  124.   buffer := "A bit of text";
  125.   IF NOT rt.GetString (ADR(buffer), 127,ADR("Enter anything:"), NIL,TAG(tagbuf,tagEnd)) THEN
  126.     vEZRequest (ADR("You entered nothing :-("),ADR("I'm sorry"),NIL, NIL, NIL);
  127.   ELSE
  128.     adr:=TAG(tagbuf,ADR (buffer));
  129.     vEZRequest (ADR("You entered this string:\n'%s'."),
  130.                 ADR("So I did"), NIL, NIL, adr );
  131.   END;
  132.   adr:=ADR(" _Ok |New _2.0 feature!|_Cancel");
  133.   adr2:=ADR("These are two new features of ReqTools 2.0:\n"+
  134.             "Text above the entry gadget and more than\n"+
  135.             "one response gadget.");
  136.   IF rt.GetString (ADR(buffer),127,ADR("Enter anything:"),NIL,
  137.                    TAG(tagbuf,rt.gsGadFmt,adr,
  138.                    rt.gsTextFmt,adr2,rt.Underscore,"_",tagEnd)) THEN END;
  139.   adr:=ADR(" _Ok |_Abort|_Cancel");
  140.   adr2:=ADR("New is also the ability to switch off the\n"+
  141.             "backfill pattern.  You can also center the\n"+
  142.             "text above the entry gadget.\n"+
  143.             "These new features are also available in\n"+
  144.             "the rtGetLong() requester.");
  145.   IF rt.GetString (ADR(buffer), 127,ADR("Enter anything:"),NIL,
  146.                    TAG(tagbuf,rt.gsGadFmt,adr,rt.gsTextFmt,adr2,
  147.                    rt.gsBackfill,FALSE,
  148.                    rt.gsFlags,LONGSET{rt.gsReqCenterText,rt.gsReqHighlightText},
  149.                    rt.Underscore,"_",tagEnd)) THEN END;
  150.  
  151.   vEZRequest (ADR("NUMBER 2:\nNumber requester\nfunction: rt.GetLong()"),
  152.               ADR("Show me"),NIL, NIL, NIL);
  153.  
  154.   IF NOT rt.GetLong (longnum,ADR("Enter a number:"), NIL,
  155.                      TAG(tagbuf,rt.glShowDefault,FALSE,tagEnd)) THEN
  156.     vEZRequest (ADR("You entered nothing :-("),ADR("I'm sorry"),NIL, NIL, NIL);
  157.   ELSE
  158.     adr:=ADR(longnum);
  159.     vEZRequest (ADR("The number you entered was:\n%ld"),
  160.                 ADR("So it was"), NIL, NIL,adr);
  161.   END;
  162.  
  163.   vEZRequest (ADR("NUMBER 3:\nMessage requester, the requester\n"+
  164.               "you've been using all the time!\nfunction: rt.EZRequest()"),
  165.               ADR("Show me more"),NIL, NIL, NIL);
  166.  
  167.   vEZRequest (ADR("Simplest usage: some body text and\na single centered gadget."),
  168.               ADR("Got it"),NIL, NIL, NIL);
  169.  
  170.   WHILE NOT (EZRequest (ADR("You can also use two gadgets to\n"+
  171.                         "ask the user something.\n"+
  172.                         "Do you understand?"),ADR("Of course|Not really"),
  173.                         NIL, NIL, NIL) # 0) DO
  174.     vEZRequest (ADR("You are not one of the brightest are you?\n"+
  175.                 "We'll try again..."),
  176.                 ADR("Ok"),NIL, NIL, NIL);
  177.   END; (* WHILE *)
  178.  
  179.   vEZRequest (ADR("Great, we'll continue then."),ADR("Fine"),NIL, NIL, NIL);
  180.  
  181.   CASE EZRequest (ADR("You can also put up a requester with\n"+
  182.                   "three choices.\n"+
  183.                   "How do you like the demo so far ?"),
  184.                   ADR("Great|So so|Rubbish"),NIL, NIL, NIL) OF
  185.     | 0:
  186.       vEZRequest (ADR("Too bad, I really hoped you\nwould like it better."),
  187.                   ADR("So what"),NIL, NIL, NIL);
  188.     | 1:
  189.       vEZRequest (ADR("I'm glad you like it so much."),ADR("Fine"),NIL, NIL, NIL);
  190.     | 2:
  191.       vEZRequest (ADR("Maybe if you run the demo again\n"+
  192.                   "you'll REALLY like it."),
  193.                   ADR("Perhaps"),NIL, NIL, NIL);
  194.   END; (* CASE *)
  195.  
  196.   ret := EZRequestTags (ADR("The number of responses is not limited to three\n"+
  197.                         "as you can see.  The gadgets are labeled with\n"+
  198.                         "the return code from rt.EZRequest().\n"+
  199.                         "Pressing Return will choose 4, note that\n"+
  200.                         "4's button text is printed in boldface."),
  201.                         ADR("1|2|3|4|5|0"), NIL, NIL,
  202.                         TAG(tagbuf,rt.ezDefaultResponse, 4, tagEnd));
  203.   adr:=ADR(ret);
  204.   vEZRequest (ADR("You picked '%ld'."),ADR("How true"), NIL, NIL,adr);
  205.   vEZRequestTags (ADR("New for Release 2.0 of ReqTools (V38) is\n"+
  206.                   "the